home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 0758 / setup.arv / PROCESS.CTM < prev    next >
Encoding:
Text File  |  1997-04-10  |  8.4 KB  |  263 lines
  1. type
  2.         keyRec = record
  3.              key theKey : string;
  4.                  theVal : string;
  5.         endRecord
  6. endType
  7.  
  8. var
  9.         session : string = '';
  10.         year : word;
  11.         month : word;
  12.         day : word;
  13.         dayOfWeek : word;
  14.         date : string;
  15.         ordFile : text;
  16.         order : text;
  17.         ARec : keyRec;
  18.         items : table of keyRec;
  19.         prices : table of keyRec;
  20.         shipping : string;
  21.         totalShipping : real;
  22.         payment : string;
  23.         fee : real;
  24.         grandTotal : real;
  25.         currentOrder : real;
  26.         tempS : string;
  27.         totalOrder : real;
  28. endVar
  29.  
  30. function intToStr(i : longint) : string;
  31. var
  32.         s : string;
  33. endVar
  34.         str(i : 0 : 0, s);
  35.         return s;
  36. endProc
  37.  
  38. function strToReal(s : string) : real;
  39. var
  40.         r : real;
  41. endVar
  42.         val(s, r);
  43.         strToReal := r;
  44. endProc
  45.  
  46. function realToStr(r : real) : string;
  47. var
  48.         s : string;
  49. endVar
  50.         str(r : 0 : 2, s);
  51.         return s;
  52. endProc
  53.  
  54. procedure main
  55.         session := fieldParm('SessionID');
  56.         if ((session = '') or (session = '*SeSiOnId*'))
  57.                 printError;
  58.                 return;
  59.         endif
  60.         getDate(year, month, day, dayOfWeek);
  61.         date := intToStr(month) + intToStr(day) + intToStr(year);
  62.         assign(ordFile, date + '.ord');
  63.         if (append(ordFile) <> 0)
  64.                 if (rewrite(ordFile) <> 0)
  65.                         printError;
  66.                         return;
  67.                 endif
  68.         endif
  69.         writeln(ordFile, session);
  70.         close(ordFile);
  71.         tempS := copy(session, 1, length(session) - 4) + '.frm';
  72.         assign(order, tempS);
  73.         if (rewrite(order) <> 0) 
  74.                 printError;
  75.                 return;
  76.         endif
  77.         loadTable(items, session);
  78.         loadTable(prices, 'prices.db');
  79.  
  80.         if (getRealItem('TotalOrder') = 0)
  81.                 printNothingOrdered;
  82.                 return;
  83.         endif
  84.  
  85.         writeTitle('Order');
  86.         printBoth('Order ID ' + session, "<h1>", "</h1>");
  87.         tempS := 'Date : ' + intToStr(month) + '/' + intToStr(day) + '/' + intToStr(year);
  88.         printBoth(tempS, '<br>', '<br>');
  89.  
  90.         writeln(order);
  91.         printBoth("Thank you for your order, here is a copy of the order that was processed", "<br>", "<br>");
  92.         writeln(order);
  93.         printCompany; { generated }
  94.         writeln(order);
  95.         printBoth("Please send me the following products :", "<br>", "");
  96.         printProducts; { generated }
  97.         printShippingCharges;
  98.         printPaymentCharges;
  99.         printGrandTotal;
  100.         printPayment;
  101.         printBoth("Shipping information", "<br><B>", "</B>");
  102.         printShipping;
  103.         printBoth("Billing information", "<br><B>", "</B>");
  104.         printBilling;
  105.         printContact;
  106.         printComments;
  107.  
  108.         close(order);
  109.  
  110.         printContinue;
  111. endProc
  112.  
  113. procedure printError
  114.         writeTitle('Script Error');
  115.         writeln('Script executed with wrong parameters');
  116. endProc
  117.  
  118. procedure printBoth(message : string; before : string; after : string);
  119.         writeln(order, message);
  120.         write(before);
  121.         write(message);
  122.         write(after);
  123. endProc
  124.  
  125. procedure printShipping;
  126.         tempS := fieldParm('SHIPNAME');
  127.         printBoth(tempS, "<br>", "");
  128.         tempS := fieldParm('SHIPTITLE');
  129.         printBoth(tempS, "<br>", "");
  130.         tempS := fieldParm('SHIPCOMPANY');
  131.         printBoth(tempS, "<br>", "");
  132.         tempS := fieldParm('SHIPADDR1');
  133.         printBoth(tempS, "<br>", "");
  134.         tempS := fieldParm('SHIPADDR2');
  135.         printBoth(tempS, "<br>", "");
  136.         tempS := fieldParm('SHIPCITY');
  137.         printBoth(tempS, "<br>", "");
  138.         tempS := fieldParm('SHIPSTATE');
  139.         printBoth(tempS, "<br>", "");
  140.         tempS := fieldParm('SHIPZIP');
  141.         printBoth(tempS, "<br>", "");
  142.         tempS := fieldParm('SHIPCOUNTRY');
  143.         printBoth(tempS, "<br>", "");
  144. endProc
  145.  
  146. procedure printBilling;
  147.         if (fieldParm('BILLNAME') = '') 
  148.                 printBoth("Same as shipping", "<br>", "<br>");
  149.         else
  150.                 tempS := fieldParm('BILLNAME');
  151.                 printBoth(tempS, "<br>", "");
  152.                 tempS := fieldParm('BILLTITLE');
  153.                 printBoth(tempS, "<br>", "");
  154.                 tempS := fieldParm('BILLCOMPANY');
  155.                 printBoth(tempS, "<br>", "");
  156.                 tempS := fieldParm('BILLADDR1');
  157.                 printBoth(tempS, "<br>", "");
  158.                 tempS := fieldParm('BILLADDR2');
  159.                 printBoth(tempS, "<br>", "");
  160.                 tempS := fieldParm('BILLCITY');
  161.                 printBoth(tempS, "<br>", "");
  162.                 tempS := fieldParm('BILLSTATE');
  163.                 printBoth(tempS, "<br>", "");
  164.                 tempS := fieldParm('BILLZIP');
  165.                 printBoth(tempS, "<br>", "");
  166.                 tempS := fieldParm('BILLCOUNTRY');
  167.                 printBoth(tempS, "<br>", "");
  168.         endif
  169. endProc
  170.  
  171. procedure printContact;
  172.         printBoth("Contact Information", "<B>", "</B>");
  173.         tempS := "Tel    : " + fieldParm('PHONE');
  174.         printBoth(tempS, "<br>", "");
  175.         tempS := "Fax    : " + fieldParm('FAX');
  176.         printBoth(tempS, "<br>", "");
  177.         tempS := "EMail1 : " + fieldParm('EMAIL1');
  178.         printBoth(tempS, "<br>", "");
  179.         tempS := "EMail2 : " + fieldParm('EMAIL2');
  180.         printBoth(tempS, "<br>", "");
  181. endProc
  182.  
  183. function getRealPrice(AKey : string) : real;
  184.         ARec.theKey := AKey;
  185.         setKeysFromRecord(prices, ARec);
  186.         if (readRecord(prices, ARec))
  187.                 return strToReal(ARec.theVal);
  188.         else
  189.                 return 0;
  190.         endif
  191. endProc
  192.  
  193. function getRealItem(AKey : string) : real;
  194.         ARec.theKey := AKey;
  195.         setKeysFromRecord(items, ARec);
  196.         if (readRecord(items, ARec))
  197.                 return strToReal(ARec.theVal);
  198.         else
  199.                 return 0;
  200.         endif
  201. endProc
  202.  
  203.  
  204. procedure printShippingCharges
  205.         printBoth("Shipping Charges", "<br><b>", "</b>");
  206.         Shipping := "S_" + fieldParm('SHIPOPT');
  207.         TotalShipping := (getRealPrice(Shipping + "3") * getRealItem('TotalProducts')) +
  208.                         getRealPrice(Shipping + "1") + (getRealPrice(Shipping + "2") * getRealItem('TotalWeight'));
  209.         tempS := "Total for " + fieldParm('SHIPOPT') + ' : $' + realToStr(TotalShipping);
  210.         printBoth(tempS, "<br>", "<br>");
  211. endProc
  212.  
  213. procedure printPayment
  214.         printBoth("Payment Method", "<br><b>", "</b>");
  215.         tempS := "Payment by " + fieldParm('PAYOPT');
  216.         printBoth(tempS, "<br>", "");
  217.         if (getRealPrice(payment + "1") = 1) 
  218.                 tempS := "PO/WT number " + fieldParm('CARDNUM');
  219.                 printBoth(tempS, "<br>", "");
  220.         else if (getRealPrice(payment + "1") = 2)
  221.                 tempS := "Card number : " + fieldParm('CARDNUM');
  222.                 printBoth(tempS, "<br>", "");
  223.                 tempS := "Name on card : " + fieldParm('NAMEONCARD');
  224.                 printBoth(tempS, "<br>", "");
  225.                 tempS := "Expiration date : " + fieldParm('EXPRDATE');  
  226.                 printBoth(tempS, "<br>", "");
  227.              endif
  228.         endif   
  229. endProc
  230.  
  231. procedure printPaymentCharges
  232.         payment := 'P_' + fieldParm('PAYOPT');
  233.         fee := getRealPrice(payment + '2');
  234.         if (fee <> 0)
  235.                 tempS := "Payment fee is $" + realToStr(fee);
  236.                 printBoth(tempS, "<br>", "<br>");
  237.         endif
  238. endProc
  239.  
  240. procedure printGrandTotal;
  241.         grandTotal := fee + getRealItem('TotalOrder') + TotalShipping;
  242.         tempS := "Total payment is $" + realToStr(GrandTotal);
  243.         printBoth(tempS, "<br>", "<br>");
  244. endProc
  245.  
  246. procedure printComments
  247.         if (fieldParm('COMMENTS') <> '')
  248.                 printBoth("Comments", "<br><b>", "</b>");
  249.                 tempS := fieldParm('COMMENTS');
  250.                 printBoth(tempS, "<br>", "");
  251.         endif
  252. endProc
  253.  
  254. procedure printNothingOrdered
  255.         writeTitle('Order Error');
  256.         writeHeading(1, 'Order Error');
  257.         write('No products were ordered!<br>');
  258.         write('Please press the Back button, specify what products you want to');
  259.         write('order by clicking the Submit button under an item's quantity table,');
  260.         write('after you have specified the number of items in the table!');
  261.         write('<HR>');
  262. endProc
  263.